perm filename PPITCH.SAI[4,ALS] blob sn#202976 filedate 1976-02-23 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PITCH"
C00007 ENDMK
C⊗;
BEGIN "PITCH"
DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,EOF;
INTEGER II,JJ,P1,P2,P3,T1,T2,T3,T,DT,H,TAU1,TAU2;
INTEGER ARRAY BUF,PITCH[0:1000];
STRING FILEN,READ,READ1,FILEO,READ2;
DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";

⊂ Three peaks are located, then tests are made on the middle
   one to determine whether it should be reported or discarded;
⊂ These peaks are P1, P2, and P3 with corresponding times of T1, T2 and T3;

⊂ The conditions for discarding are
    a) just getting started, P1=0
   b) the middle peak is definitely smaller than one at the ends
   c) the time interval between P1 and P2 is too small
   d) the time interval is too large;

FILEN←"FLTD.001[DAT,NJM]";
OUTSTR("Type file name (CR for "&FILEN&".");
IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
  READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
  READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
  IF READ2="." THEN DONE; END;
  FILEO←READ1&"PCH";
  POINTY←POINT(12,PITCH[0],-1);
TAU1←40;
OUTSTR("Set TAU1 (CR for 40) ");IF (READ←INCHWL)≠"" THEN TAU1←CVD(READ);
TAU2←140;
OUTSTR("Set TAU2 (CR for 140) ");IF (READ←INCHWL)≠"" THEN TAU2←CVD(READ);
DELTA←1200;
OUTSTR("Type value for DELTA (CR for 1200) ");
IF (READ←INCHWL)≠"" THEN DELTA←CVD(READ);
CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
LOOKUP(CHAN1,FILEN,0);
J←K←L←STATE←VAL←R←0;
OUTSTR(CRLF&"Pitch  measure on file "&FILEN &CRLF&LF);
OUTSTR("   T   P   A      T   P   A      T   P   A      T   P   A"&CRLF&LF);
SETFORMAT(4,0); P←P1←P2←P3←T1←T2←T3←H←Q←0;
WHILE EOF=0 DO BEGIN
  FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
  ARRYIN(CHAN1,BUF[0],1000);
  POINTX←POINT(12,BUF[0],-1);
FOR I←0 STEP 1 UNTIL 2999 DO BEGIN
    L←K*1500+I%2;
    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;

IF H>0 THEN IF VAL≤0 THEN IF L-T3>6 THEN T←L;

IF VAL>0 THEN IF H≤0 THEN BEGIN
  WHILE TRUE DO BEGIN


    IF P<P3 THEN DONE;

⊂    IF L-T<6 THEN DONE;

    IF P1<DELTA THEN BEGIN
      P1←P2; T1←T2; P2←P; T2←T3; DONE END;

    IF T2-T1>TAU2 THEN BEGIN
       P1←P2; T1←T2; P2←P; T2←T3; DONE END;

    IF P2<DELTA THEN BEGIN
      P2←P; T2←T3; DONE END;

    IF T2-T1<TAU1 THEN BEGIN
      IF P2>P1 THEN BEGIN
        P1←P2; T1←T2; P2←P; T2←T3; DONE END ELSE BEGIN
        P2←P; T2←T3; DONE END; END;

    IF P2<P1 THEN IF P2<P THEN IF T3-T1<TAU2 THEN BEGIN
      P2←P; T2←T3; DONE END;

    OUTSTR(CVS(T1%10)&CVS(T2-T1)&CVS(P1 LSH -9)&"   ");
    IF (R MOD 4)=3 THEN BEGIN OUTSTR(CRLF); R←0; END ELSE R←R+1;
    TAU1←(2*TAU1+2*(T2-T1))%5;
    IF TAU1<40 THEN TAU1←40;
    TAU2←(4*TAU2+T2-T1) LSH -2;
    IF TAU2>140 THEN TAU2←140;
    Q←Q+1;
    IDPB(T1%100,POINTY); IDPB(T2-T1,POINTY); IDPB((P1 LSH -9),POINTY);
    P1←P2; T1←T2; P2←P; T2←T3; DONE END;
  P3←P; T3←L; P←0; END;
H←VAL;
IF VAL>0 THEN P←P+VAL ELSE P←P-VAL;

  END;
K←K+1;

END;

CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
ENTER(CHAN1,FILEO,0);
ARRYOUT(CHAN1,PITCH[0],Q); RELEASE(CHAN1);
END "PITCH";